CD Actual 16/PC Actual CD 16.iso/autocad/R14701.DXR/00008_Utilities - from slideshow.ls

Text File | 1997-04-24 | 8.0 KB | 295 lines

on clickedOnFieldLIne myLineNum, myField, myInitLineNum, myShiftDown
  if the type of member myField <> #field then
    exit
  end if
  if (myLineNum < 1) or (myLineNum > the number of lines in field myField) then
    hilite line the number of lines in field myField + 1 of field myField
    return 0
  else
    if (myShiftDown = 1) and (myInitLineNum > 0) and (myInitLineNum <> myLineNum) then
      if myInitLineNum > myLineNum then
        set temp to myLineNum
        set myLineNum to myInitLineNum
        set myInitLineNum to temp
      end if
      if myInitLineNum = 1 then
        set tFirstChar to 1
      else
        set tFirstChar to length(line 1 to myInitLineNum - 1 of field myField) + 2
      end if
      hilite char tFirstChar to length(line 1 to myLineNum of field myField) + 1 of field myField
      return [myInitLineNum, myLineNum]
    else
      if myLineNum = 1 then
        set tFirstChar to 1
      else
        set tFirstChar to length(line 1 to myLineNum - 1 of field myField) + 2
      end if
      hilite char tFirstChar to length(line 1 to myLineNum of field myField) + 1 of field myField
      return myLineNum
    end if
  end if
end

on moveLineInField myLineNum, myField, myDirection, myCoordList
  if myLineNum = 0 then
    exit
  end if
  if the last line in field myField = RETURN then
    set tNumOfLines to the number of lines in field myField - 1
  else
    set tNumOfLines to the number of lines in field myField
  end if
  if voidp(myCoordList) then
    set tListFlag to 0
  else
    set tListFlag to 1
  end if
  set tCurrLineText to line myLineNum of field myField
  if tListFlag then
    set tCurrListItem to getAt(myCoordList, myLineNum)
  end if
  case myDirection of
    #up:
      if myLineNum = 1 then
        return [#line: myLineNum, #list: myCoordList]
      end if
      delete line myLineNum of field myField
      if tListFlag then
        deleteAt(myCoordList, myLineNum)
      end if
      set myLineNum to myLineNum - 1
      put tCurrLineText & RETURN before line myLineNum of field myField
      if tListFlag then
        addAt(myCoordList, myLineNum, tCurrListItem)
      end if
    #down:
      if myLineNum = tNumOfLines then
        return [#line: myLineNum, #list: myCoordList]
      end if
      delete line myLineNum of field myField
      if tListFlag then
        deleteAt(myCoordList, myLineNum)
      end if
      put RETURN & tCurrLineText after line myLineNum of field myField
      set myLineNum to myLineNum + 1
      if tListFlag then
        addAt(myCoordList, myLineNum, tCurrListItem)
      end if
  end case
  clickedOnFieldLIne(myLineNum, myField)
  return [#line: myLineNum, #list: myCoordList]
end

on puppetAllSprites myState
  repeat with tSprite = 1 to 48
    set the puppet of sprite tSprite to myState
  end repeat
end

on wait myTicks
  set tTicks to the ticks
  repeat while the ticks < (tTicks + myTicks)
    nothing()
  end repeat
end

on doesXtraExist myXtraName
  set tFoundXtra to 0
  repeat with i = 1 to the number of xtras
    if the name of xtra(i) = myXtraName then
      set tFoundXtra to 1
      exit repeat
    end if
  end repeat
  return tFoundXtra
end

on findFile myPath, myFile
  if doesXtraExist("fileIO") then
    set tFileIO to new(xtra("fileIO"))
    if the last char in myPath <> "\" then
      put "\" after myPath
    end if
    openFile(tFileIO, myPath & myFile, 1)
    if status(tFileIO) = 0 then
      set tFoundFile to 1
    else
      set tFoundFile to 0
    end if
    closeFile(tFileIO)
    set tFileIO to 0
  else
    set tFoundFile to 0
    repeat with i = 1 to the maxinteger
      set tFileName to getNthFileNameInFolder(myPath, i)
      if tFileName = EMPTY then
        exit repeat
      end if
      if tFileName = myFile then
        set tFoundFile to 1
        exit repeat
      end if
    end repeat
  end if
  return tFoundFile
end

on buildFileListByType myPath, myFileType, myStringExtensionFlag
  set tReturnList to []
  sort(tReturnList)
  repeat with i = 1 to the maxinteger
    set tFileName to getNthFileNameInFolder(myPath, i)
    if tFileName = EMPTY then
      exit repeat
    end if
    if getFileType(tFileName) = myFileType then
      if myStringExtensionFlag = 1 then
        add(tReturnList, getFileNameOnly(tFileName))
        next repeat
      end if
      add(tReturnList, tFileName)
    end if
  end repeat
  return tReturnList
end

on linearListToString myList
  if not ilk(myList, #linearList) then
    exit
  end if
  set tReturnString to EMPTY
  repeat with tEntry in myList
    put tEntry & RETURN after tReturnString
  end repeat
  delete char -30000 of tReturnString
  return tReturnString
end

on changeCastlib myCastlibNum
  beginRecording()
  repeat with i = 1 to 48
    set the castLibNum of sprite i to myCastlibNum
  end repeat
  endRecording()
end

on putCharIntoAllFields myChar, myCastlibNum
  repeat with i = 1 to the number of castMembers of castLib myCastlibNum
    if the type of member i of castLib myCastlibNum <> #field then
      next repeat
    end if
    put myChar into field i of castLib myCastlibNum
  end repeat
end

on getFileType myFilename
  set tOldDelimiter to the itemDelimiter
  set the itemDelimiter to "."
  set tFileType to item 2 of myFilename
  set the itemDelimiter to tOldDelimiter
  if tFileType = EMPTY then
    return 0
  else
    return tFileType
  end if
end

on getFileNameOnly myFilename
  set tOldDelimiter to the itemDelimiter
  set the itemDelimiter to "."
  set tFileName to item 1 of myFilename
  set the itemDelimiter to tOldDelimiter
  if tFileName = EMPTY then
    return 0
  else
    return tFileName
  end if
end

on getCDPath myPath, myTokenFile, myStartLetter, myEndLetter
  if char 3 of myPath = "\" then
    delete char 1 to 2 of myPath
  end if
  if (char 1 of myPath <> "\") or (the last char in myPath <> "\") then
    alert("Invalid path specified for getDriveLetter() function")
    halt()
  end if
  repeat with tDriveChar = charToNum(myStartLetter) to charToNum(myEndLetter)
    set tPath to numToChar(tDriveChar) & ":" & myPath
    if findFile(tPath, myTokenFile) then
      return numToChar(tDriveChar) & ":" & myPath
    end if
  end repeat
  alert("The CD-ROM was not found in any drive on your system.  " & "Please make sure it is inserted properly.")
  halt()
end

on exitprocedure
  set the windowList to []
  halt()
end

on ExitMIAW
  global gDialogbox
  set gDialogbox to window "ExitMIAW"
  set the windowType of window 1 to 2
  set the rect of gDialogbox to the rect of the stage
  open(gDialogbox)
end

on getCurrPalette
  global gCurrTopicObj, gStagePalNum
  if objectp(gCurrentTopicObj) then
    return the number of member the pPalette of gCurrTopicObj
  else
    return 0
  end if
end

on shiftList myList, myDirection
  if not ilk(myList, #propList) then
    return 0
  end if
  set tNewList to [:]
  case myDirection of
    #prev:
      addProp(tNewList, #curr, the prev of myList)
      addProp(tNewList, #next, the curr of myList)
      addProp(tNewList, #prev, the next of myList)
    #next:
      addProp(tNewList, #curr, the next of myList)
      addProp(tNewList, #next, the prev of myList)
      addProp(tNewList, #prev, the curr of myList)
    otherwise:
      return 0
  end case
  return tNewList
end

on addPropListToPropList myOrigList, myListToAdd
  if not ilk(myOrigList, #propList) or not ilk(myListToAdd, #propList) then
    return 0
  end if
  set tNumOfElementsToAdd to count(myListToAdd)
  repeat with i = 1 to tNumOfElementsToAdd
    set tNewProp to getPropAt(myListToAdd, i)
    if not voidp(getaProp(myOrigList, tNewProp)) then
      alert("addPropListToPropList: Probably, two slides have the same name of: " & tNewProp)
    end if
    set tNewElem to getAt(myListToAdd, i)
    addProp(myOrigList, tNewProp, tNewElem)
  end repeat
  return myOrigList
end

on removeLFCharFromText myInputText
  set tNumberOfLines to the number of lines in myInputText
  repeat with tCurrLineNum = 1 to tNumberOfLines
    if charToNum(char 1 of line tCurrLineNum of myInputText) = 10 then
      delete char 1 of line tCurrLineNum of myInputText
    end if
  end repeat
  return myInputText
end